home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / HELIX.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1997-01-28  |  4.7 KB  |  176 lines
  1. 10  'HELIX - Helical Winding - 23 JAN 94 rev.27 SEP 96
  2. 20  IF EX$=""THEN EX$="EXIT"
  3. 30  CLS:KEY OFF
  4. 40  COLOR 7,0,1
  5. 50  PI=3.14159
  6. 60  E$=STRING$(80,32)
  7. 70  E1$=STRING$(7,32)
  8. 80  UL$=STRING$(80,205)
  9. 90  U1$="####.###"
  10. 100  '
  11. 110  '.....start
  12. 120  CLS:P=0:N=0:LW=0:LC=0
  13. 130  COLOR 15,2
  14. 140  PRINT " HELICAL WINDINGS";TAB(57);"by George Murphy VE3ERP ";
  15. 150  COLOR 1,0:PRINT STRING$(80,223);
  16. 160  COLOR 7,0
  17. 170  '
  18. 180  GOSUB 1510
  19. 190  PRINT UL$;
  20. 200  PRINT " Please enter all dimensions in the same units, e.g. inches, ";
  21. 210  PRINT "millimetres, etc."
  22. 220  PRINT
  23. 230  PRINT " If you do not know the data requested, press <ENTER> to bypass ";
  24. 240  PRINT "the request."
  25. 250  PRINT " If the data is critical, you will be asked for it again."
  26. 260  PRINT UL$;
  27. 270  COLOR 0,7:LOCATE CSRLIN,22
  28. 280  PRINT " Press 1 to continue or 0 to EXIT....."
  29. 290  COLOR 7,0
  30. 300  Z$=INKEY$:IF Z$=""THEN 300
  31. 310  IF Z$="0"THEN CLS:RUN EX$
  32. 320  IF Z$="1"THEN 340
  33. 330  GOTO 300
  34. 340  LOCATE CSRLIN-1:PRINT E$;:LOCATE CSRLIN-1
  35. 350  INPUT " ENTER: Filament outside diameter.........................";OD
  36. 360  IF OD=0 THEN LOCATE CSRLIN-1:PRINT E$;:LOCATE CSRLIN-1:GOTO 350
  37. 370  LOCATE CSRLIN-1:PRINT E1$;:LOCATE CSRLIN,59:PRINT USING U1$;OD
  38. 380  '
  39. 390  INPUT " ENTER: Winding form outside diameter.....................";CD
  40. 400  IF CD=0 THEN LOCATE CSRLIN-1:PRINT E$;:LOCATE CSRLIN-1:GOTO 390
  41. 410  LOCATE CSRLIN-1:PRINT E1$;:LOCATE CSRLIN,59:PRINT USING U1$;CD
  42. 420  '
  43. 430  MD=CD+OD   'mean winding diameter
  44. 440  C=PI*MD    'mean circumference
  45. 450  '
  46. 460  IF P THEN 510
  47. 470  INPUT " ENTER: Pitch (centre-to-centre distance between turns)...";P
  48. 480  LOCATE CSRLIN-1:PRINT E$;:LOCATE CSRLIN-1
  49. 490  GOSUB 1220
  50. 500  '
  51. 510  IF N THEN 560
  52. 520  INPUT " ENTER: Number of turns...................................";N
  53. 530  LOCATE CSRLIN-1:PRINT E$;:LOCATE CSRLIN-1
  54. 540  GOSUB 1220
  55. 550  '
  56. 560  IF LW THEN 600
  57. 570  INPUT " ENTER: Length of helical winding.........................";LW
  58. 580  LOCATE CSRLIN-1:PRINT E$;:LOCATE CSRLIN-1
  59. 590  GOSUB 1220
  60. 600  '
  61. 610  IF LC THEN 660
  62. 620  INPUT " ENTER: Length of filament................................";LC
  63. 630  LOCATE CSRLIN-1:PRINT E$;:LOCATE CSRLIN-1
  64. 640  GOSUB 1220
  65. 650  '
  66. 660  IF P*N*LW*LC THEN 690
  67. 670  GOTO 460
  68. 680  '
  69. 690  '.....display
  70. 700  IF P<OD OR LW<OD*N THEN 1420
  71. 710  PRINT "        Pitch (centre-to-centre distance between turns)...";
  72. 720  PRINT USING U1$;P
  73. 730  PA=ATN(P/C)*180/3.14159
  74. 740  PRINT "        Pitch Angle (slope of windings)...................";
  75. 750  PRINT USING U1$;PA;:PRINT "<UNK! {00F8}>"
  76. 760  PRINT "        Length of filament in one (1) turn................";
  77. 770  PRINT USING U1$;T
  78. 780  PRINT "        Number of turns...................................";
  79. 790  PRINT USING U1$;N
  80. 800  PRINT "        Length of helical winding.........................";
  81. 810  PRINT USING U1$;LW
  82. 820  TPI=N/LW
  83. 830  PRINT "        Turns per inch....................................";
  84. 840  PRINT USING U1$;TPI
  85. 850  RA=LW/(CD+OD)
  86. 860  PRINT "        Length-to-Diameter ratio..........................";
  87. 870  PRINT USING U1$;RA;:PRINT ":1"
  88. 880  PRINT "        Length of filament................................";
  89. 890  PRINT USING U1$;LC
  90. 900  PRINT UL$;
  91. 910  VIEW PRINT 3 TO 11:CLS:VIEW PRINT
  92. 920  LN=17:GOSUB 1630
  93. 930  LOCATE 25,1:PRINT E$;
  94. 940  LOCATE 25,13:COLOR 15,2
  95. 950  PRINT " Would you like to see a helix winding table?    (y/n) ";
  96. 960  Z$=INKEY$
  97. 970  IF Z$="n"THEN COLOR 7,0:GOTO 110    'start
  98. 980  IF Z$="y"THEN 1010
  99. 990  GOTO 960
  100. 1000  '
  101. 1010  '.....helix winding table
  102. 1020  COLOR 7,0
  103. 1030  VIEW PRINT 3 TO 24:CLS:VIEW PRINT:LOCATE 3
  104. 1040  Y$="DISTANCES OF EACH FULL WINDING FROM END OF HELIX"
  105. 1050  PRINT TAB(INT(80-LEN(Y$))/2);Y$
  106. 1060  N$=STR$(INT(N*100+0.5)/100)
  107. 1070  LW$=STR$(INT(LW*100)/100)
  108. 1080  X$=N$+" turn helix"+LW$+" units long"
  109. 1090  PRINT TAB(INT(80-LEN(X$))/2);X$
  110. 1100  PRINT TAB(8);
  111. 1110  PRINT "( Distances are in same unit of measurement as the helix length.)"
  112. 1120  PRINT UL$;
  113. 1130  LN=6       'line number
  114. 1140  FOR Z=1 TO N
  115. 1150   LN=LN+0.1                '.1 = 10 numbers per line
  116. 1160    PRINT USING "#####.##";Z*P;
  117. 1170   IF LN>=24 THEN GOSUB 1630:CLS:LN=0
  118. 1180  NEXT Z
  119. 1190  GOSUB 1630
  120. 1200  GOTO 110   'start
  121. 1210  '
  122. 1220  '.....calculate
  123. 1230  FOR Q=1 TO 3
  124. 1240  IF T*C<>0 AND T<=C THEN 1420
  125. 1250  IF T*MD<>0 THEN IF T<PI*MD THEN 1420
  126. 1260  IF LC*LW<>0 THEN IF LC<LW THEN 1420
  127. 1270  '
  128. 1280  IF T=0 AND P*C<>0 THEN T=SQR(P^2+C^2)    'T= length of 1 turn
  129. 1290  IF T=0 AND LC*N<>0 THEN T=LC/N
  130. 1300  IF P=0 AND LW*N<>0 THEN P=LW/N           'P= pitch
  131. 1310  IF P=0 AND C*T<>0 AND T>=C THEN P=SQR(T^2-C^2)
  132. 1320  IF N=0 AND LW*P<>0 THEN N=LW/P           'N= number of turns
  133. 1330  IF N=0 AND LC*T<>0 THEN N=LC/T
  134. 1340  IF N=0 AND LC*LW<>0 THEN N=SQR(LC^2-LW^2)/C
  135. 1350  IF LW=0 AND P*N<>0 THEN LW=P*N           'LW= length of helical winding
  136. 1360  IF LC=0 AND T*N<>0 THEN LC=T*N           'LC= length of conductor
  137. 1370  IF P*OD<>0 AND P<OD THEN 1420
  138. 1380  IF LC*LW<>0 AND N=0 THEN IF LC<=LW THEN 1420
  139. 1390  NEXT Q
  140. 1400  RETURN
  141. 1410  '
  142. 1420  '.....error warning
  143. 1430  BEEP:PRINT " ";:COLOR 11,4
  144. 1440  PRINT " NOT POSSIBLE - TRY AGAIN ! "
  145. 1450  COLOR 7,0
  146. 1460  PRINT " Press any key........"
  147. 1470  IF INKEY$=""THEN 1470
  148. 1480  GOTO 110   'start
  149. 1490  END
  150. 1500  '
  151. 1510  '.....preface
  152. 1520  T=7
  153. 1530  PRINT TAB(T);
  154. 1540  PRINT "This program will compute the geometric parameters and dimensions"
  155. 1550  PRINT TAB(T);
  156. 1560  PRINT "of a filament wound in the form of a helix of constant diameter"
  157. 1570  PRINT TAB(T);
  158. 1580  PRINT "with equal spacing between turns as, for instance, in the case of"
  159. 1590  PRINT TAB(T);
  160. 1600  PRINT "spiral wound antenna element."
  161. 1610  RETURN
  162. 1620  '
  163. 1630  'HARDCOPY
  164. 1640  GOSUB 1750:LOCATE 25,2:COLOR 14,6
  165. 1650  PRINT " Press 1 to print screen, 2 to print screen & ";
  166. 1660  PRINT "advance paper, or 3 to continue.";:COLOR 7,0
  167. 1670  Z$=INKEY$:IF Z$="3"THEN GOSUB 1750:RETURN
  168. 1680  IF Z$="1"OR Z$="2"THEN GOSUB 1750:GOTO 1700
  169. 1690  GOTO 1670
  170. 1700  FOR QX=1 TO 24:FOR QY=1 TO 80
  171. 1710  LPRINT CHR$(SCREEN(QX,QY));
  172. 1720  NEXT QY:NEXT QX
  173. 1730  IF Z$="2"THEN LPRINT CHR$(12)
  174. 1740  GOTO 1640
  175. 1750  LOCATE 25,1:PRINT STRING$(80,32);:RETURN
  176.